home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / DISKINFO.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-05  |  7KB  |  169 lines
  1. ERKAN KAYA
  2. Program Diskinformations;
  3. uses crt;
  4.  
  5. Type s80=string[80];
  6.  
  7. var
  8.    c        : array[1..512] of char;
  9.    i        : integer;
  10.    ch       : char;
  11.    drive    : byte;
  12.    hex1,hex2,hex3,hex4,fatid:char;
  13.  
  14.  Procedure DiskRead(Var c;Surucu:byte;SecterNo:integer);
  15.     begin inline($1e/$55/$c5/$9e/c/$8a/$46/$06/$8b/$56/$04/$b9/$01/$00/$cd/$25/$9d/$5d/$1f);end;
  16.  
  17.  Function DiskSize(PDrive:byte):integer;
  18.     begin inline($b4/$36/$8a/$56/$04/$cd/$21/$f7/$e2/$f7/$e1/$bb/$00/$04/$f7/$f3/$89/$46/$06);end;
  19.  
  20.  Function Drives:byte;
  21.     begin inline($cd/$11/$c6/$46/$04/$00/$d0/$e8/$73/$09/$b1/$05/$d2/$e8/$fe/$c0/$88/$46/$04);end;
  22.  
  23.  Function Des(hexa : char):byte;
  24.     begin des:=0;
  25.           case hexa of
  26.                '0': des:=0; '1': des:=1; '2': des:=2; '3': des:=3;
  27.                '4': des:=4; '5': des:=5; '6': des:=6; '7': des:=7;
  28.                '8': des:=8; '9': des:=9;
  29.                'A','a': des:=10;  'B','b': des:=11; 'C','c': des:=12;
  30.                'D','d': des:=13;  'E','e': des:=14; 'F','f': des:=15;
  31.           end;
  32.     end;
  33.  
  34.  Function Hex(deca : byte):char;
  35.     begin hex:='0';
  36.           case deca of
  37.                0: hex:='0'; 1: hex:='1'; 2: hex:='2'; 3: hex:='3';
  38.                4: hex:='4'; 5: hex:='5'; 6: hex:='6'; 7: hex:='7';
  39.                8: hex:='8'; 9: hex:='9';
  40.                10: hex:='A';  11: hex:='B'; 12: hex:='C';
  41.                13: hex:='D';  14: hex:='E'; 15: hex:='F';
  42.           end;
  43.     end;
  44.  
  45.  Procedure Hexs(c1,c2 : char;var hex1,hex2,hex3,hex4:char);
  46.     begin
  47.          hex1:=hex(Ord(c2)div 16);
  48.          hex2:=hex(Ord(c2)-(Ord(c2)div 16)*16);
  49.          hex3:=hex(Ord(c1)div 16);
  50.          hex4:=hex(Ord(c1)-(Ord(c1)div 16)*16);
  51.     end;
  52.  
  53.  Procedure ConV(c1,c2 : char;var i:integer); var hex1,hex2,hex3,hex4:char;
  54.     begin i:=0;
  55.           Hexs(c1,c2,hex1,hex2,hex3,hex4);
  56.           i:=(des(hex1)*4096)+(des(hex2)*256)+(des(hex3)*16)+(des(hex4))
  57.     end;
  58.  
  59.  Procedure Cizgi(kod:char);var say:integer;
  60.     begin for say:=1 to 80 do Write(kod);end;
  61.  
  62.  Procedure Beep; begin Sound(220);Delay(2);NoSound;end;
  63.  
  64.  Procedure SatirSil(n:byte); var say:byte;
  65.     begin  TextColor(7);TextBackground(0);For say:=1 to n do DelLine;end;
  66.  
  67.  Procedure DiskInfo;
  68.     var
  69.        f1,f2,f3,f4,f5,s1,s2,i,say : integer;
  70.        r,cluster : real;
  71.        DriveName : char;
  72.        DiskArea  : integer;
  73.        DisketType: string[80];
  74.        sat,sut   : byte;
  75.     begin
  76.          TextColor(15);TextBackground(1);clrscr;
  77.          Drive:=0; DiskArea:=0; cluster:=0.0;f1:=0;f2:=0;f3:=0;f4:=0;f5:=0;s1:=0;s2:=0;
  78.          Writeln;cizgi(#205);
  79.          Write(' ························ Disk ÿnformation Utility····························· ');
  80.          cizgi(#205);cizgi(#196);
  81.          Write(' Sürücü : '); sut:=whereX;sat:=whereY;
  82.          Writeln;cizgi(#196);
  83.          Repeat
  84.                GotoXY(sut,Sat);driveName:=ReadKey;
  85.                DriveName:=UpCase(DriveName);Writeln(DriveNAme);
  86.          Until DriveName in ['A'..'E','Q',#27]; if DriveName=#27 then DriveName:='Q';
  87.          Writeln;Writeln;
  88.          Case DriveName of
  89.               'A' : Drive:=0;
  90.               'B' : Drive:=1;
  91.               'C' : Drive:=2;
  92.               'D' : Drive:=3;
  93.               'E' : Drive:=4;
  94.               'Q' : begin beep;Writeln;Writeln(' ÿƒlem iptal edildi !'+#13);
  95.                           cizgi(#196);cizgi(#205);SatirSil(11);Exit;
  96.                     end;
  97.          end;{Case}
  98.          cizgi(#205);
  99.          if Drive>Drives then Begin Beep;Writeln;Writeln(' Geçersiz Sürücü ! ÿƒlem iptal edildi');
  100.                                     cizgi(#196);cizgi(#205);SatirSil(11);Exit;
  101.                               end;
  102.          {$i-}
  103.          for say:=1 to 512 do c[say]:=#00;
  104.          DiskRead(c,drive,0);
  105.          DiskArea:=DiskSize(drive+1);
  106.          {$i+}
  107.          if (c[1]=#00)or(ioresult<>0)then begin Writeln;Writeln(' Diskten Boot okunamadì...');beep;
  108.                                                 cizgi(#196);cizgi(#205);SatirSil(9);Exit;
  109.                                           end;
  110.          if C[1]<>#235 then begin Writeln;Writeln(' Boot Sectör Bozuk...');beep;
  111.                                   cizgi(#196);cizgi(#205);SatirSil(9);Exit;
  112.                             end;
  113.          Case c[13] of #0 : i:=128;#1 : i:=256;#2 : i:=512;#3 : i:=1024;end;
  114.          GotoXY(1,10);
  115.          Hexs(c[2],c[3],hex1,hex2,hex3,hex4);
  116.          Writeln('  Boot Jump          : ',hex3,hex4,' hex  ');
  117.          Writeln('  Format iƒareti     : ',c[4],c[5],c[6],c[7],c[8],c[9],c[10],c[11]);
  118.          Writeln('  Sectör Bilgi Alanì : ',i,' byte');
  119.          f1:=i;
  120.          Writeln('  CLuster            : ',ord(c[14]),' sectör');
  121.          Writeln('  Fat Sayìsì         : ',ord(c[17]));
  122.          f2:=i;f3:=ord(c[17]);
  123.          Writeln('  Root Alanì         : ',i,' dosya ');
  124.          f4:=i;
  125.          Hexs(c[20],c[21],hex1,hex2,hex3,hex4);
  126.          i:=(des(hex1)*4096)+(des(hex2)*256)+(des(hex3)*16)+(des(hex4));
  127.          r:=(des(hex1)*4096.0)+(des(hex2)*256.0)+(des(hex3)*16.0)+(des(hex4));
  128.          GotoXY(40,11);Writeln(' Media descriptör        : ',hex1,hex2,' hex');
  129.          Conv(c[23],c[24],i);GotoXY(40,12);Writeln(' FAT`ìn sectör sayìsì    : ',i);
  130.          f5:=i;
  131.          Conv(c[25],c[26],i);GotoXY(40,13);Writeln(' Tracktaki sectör sayìsì : ',i);
  132.          Conv(c[27],c[28],i);GotoXY(40,14);Writeln(' Yüzey sayìsì            : ',i);
  133.          Conv(c[29],c[30],i);GotoXY(40,15);Writeln(' Saklì sectör sayìsì     : ',i);
  134.          cizgi(#196);s1:=f3*f5;
  135.          if (s1>10000)or(f1>1024) then s2:=0 else s2:=((f4*32)div f1)+s1;
  136.          Writeln('  Boot               : ',(f2-1),' sectör');
  137.          Writeln('  FAT                : ',f2,'-',s1,' sectör');
  138.          Writeln('  Root               : ',(s1+1),'-',(r-1.0):6:0,' sectör');
  139.          DisketType:='tanìmsìz';
  140.          if (diskArea>1500)and(drive>1) then DisketType:='HardDisk';
  141.          Case DiskArea of
  142.               354 : DisketType:='360 kb. 5"` 40 track / 9 sector ';
  143.               713 : DisketType:='720 kb. 3"` 80 track / 9 sector ';
  144.              1185 : DisketType:='1.2 Mb. 5"` 80 track / 15 sector ';
  145.              1423 : DisketType:='1.44 Mb. 3"` 80 track / 18 sector ';
  146.          end;{Case diskArea}
  147.          Writeln('  Disk tipi          : ',DisketType);
  148.          GotoXY(40,17);Writeln(' Data alanì              : ',diskArea:6,' kb.');
  149.          cluster:=(r-(s2+1))/ord(c[14]);
  150.          GotoXY(40,18);Writeln(' Cluster sayìsì          : ',cluster:6:0,' kb.');
  151.          if c[2]>#60 then begin
  152.                                 Hexs(c[42],c[43],hex1,hex2,hex3,hex4);
  153.                                 gotoXY(40,19);Write(' Disk Seri No            : ');
  154.                                 Write(hex1,hex2,hex3,hex4,'-');
  155.                                 Hexs(c[40],c[41],hex1,hex2,hex3,hex4);
  156.                                 Write(hex1,hex2,hex3,hex4);
  157.                                 gotoXY(40,20);Write(' Disk Etiketi            : ');
  158.                                 for say:=44 to 54 do write(c[say]);
  159.                             end;{if}
  160.          writeln;Writeln;
  161.          cizgi(#205);TextColor(7);TextBackground(0);
  162.     end;{Disk info}
  163.  
  164. {Ana Program}
  165. Begin
  166.      Diskinfo;
  167.      Satirsil(1);
  168.      Readkey;
  169. end.